{
  Copyright 2012 Sergey Ostanin

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
}

unit ClassifyQuestionScreen;

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, ExtCtrls, TestUiUtils,
  TestCore, ClassifyQuestion, VisualUtils, MiscUtils, PadWidget,
  DragSpace, Math, Graphics, QuestionScreens, types;

type
  TClassifyQuestionScreenFrame = class(TFrame, IQuestionScreen, IDragSpaceHost{ internal })
    pnlQuestion: TPanel;
    sbxQuestion: TScrollBox;
    procedure sbxQuestionMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  private
    FQuestion: TClassifyQuestion;
    FFormulation: TPadWidget;
    FDragSpace: TDragSpaceFrame;
    FLeft: TPadWidgetList;
    FRight: TPadWidgetList;
    FDivider: TShape;
    FOldContainerIndex: Integer;
    function GetContainerIndexUnderItem(Widget: TPadWidget): Integer;
    { private declarations }
  public
    destructor Destroy; override;
    procedure SetUp(Question: TQuestion);
    procedure GoReadOnly;
    function GetQuestion: TQuestion;

    { IDragSpaceHost (internal) }
    procedure LayOut;
    procedure NotifyBeginDrag;
    procedure NotifyDragging;
    procedure NotifyEndDrag;

    { public declarations }
  end;

implementation

{$R *.lfm}

const
  ITEM_VSPACING = 13;
  CATEGORY_VSPACING = 20;
  HSPACING = 10;
  CONTAINER_MARGIN = 10;
  DIVIDER_WIDTH = 2;
  CONTAINER_COLOR = $d0d0d0;
  HOT_TRACK_CONTAINER_COLOR = $80ffb3;

{ TClassifyQuestionScreenFrame }

procedure TClassifyQuestionScreenFrame.sbxQuestionMouseWheel(Sender: TObject;
  Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
  var Handled: Boolean);
begin
  FDragSpace.NotifyScroll(ScrollVerticallyByWheel(sbxQuestion, WheelDelta));
  Handled := TRUE;
end;

function TClassifyQuestionScreenFrame.GetContainerIndexUnderItem(
  Widget: TPadWidget): Integer;
var
  i, p1, p2: Integer;
  Container: TShape;

  function GetCommonVerticalPixels(ContainerIndex: Integer): Integer;
  var
    Category: TPadWidget;
    c: TShape;
    y1, y2: Integer;
  begin
    if (ContainerIndex >= 0) and (ContainerIndex < FLeft.Count) then
    begin
      Category := FLeft[ContainerIndex];
      c := TShape(Category.Tag);
      if IntersectSegments(Widget.Top, Widget.Top + Widget.Height,
        Category.Top, c.Top + c.Height, y1, y2) then
        Result := y2 - y1
      else
        Result := 0;
    end
    else
      Result := 0;
  end;

begin
  Result := -1;
  if FLeft.Count > 0 then
    Container := TShape(FLeft[0].Tag)
  else
    Container := nil;
  if (Container <> nil) and SegmentsOverlap(Widget.Left, Widget.Left + Widget.Width,
    Container.Left, Container.Left + Container.Width) then
  begin
    p1 := 0;
    for i := 0 to FLeft.Count-1 do
    begin
      p1 := GetCommonVerticalPixels(i);
      if p1 > 0 then
        Break;
    end;
    if p1 > 0 then
    begin
      if i < FLeft.Count-1 then
        p2 := GetCommonVerticalPixels(i + 1)
      else
        p2 := 0;
      if p1 > p2 then
        Result := i
      else
        Result := i + 1;
    end;
  end;
end;

destructor TClassifyQuestionScreenFrame.Destroy;
begin
  FreeAndNil(FLeft);
  FreeAndNil(FRight);
  FreeAndNil(FDivider);
  FreeAndNil(FDragSpace);
  FreeAndNil(FFormulation);
  FreeAndNil(FQuestion);
  inherited;
end;

procedure TClassifyQuestionScreenFrame.SetUp(Question: TQuestion);
var
  Answer: TIntegerArray;
  Category, i: Integer;
  Widget: TPadWidget;
  Container: TShape;
begin
  FQuestion := (Question as TClassifyQuestion).Clone as TClassifyQuestion;
  MakeVerticallyAutoScrollable(sbxQuestion);

  DisableAutoSizing;
  try
    FFormulation := TPadWidget.Create(nil);
    FFormulation.Border := TRUE;
    FFormulation.Parent := pnlQuestion;
    FFormulation.ReadOnly := TRUE;
    FFormulation.Model.Assign(FQuestion.Formulation);

    FDragSpace := TDragSpaceFrame.Create(nil);
    FDragSpace.Parent := pnlQuestion;

    Answer := FQuestion.Response.GetAnswer;
    Assert( Length(Answer) = FQuestion.Right.Count );
    for Category in Answer do
    begin
      Assert( Category >= -1 );
      Assert( Category < FQuestion.CategoryCount );
    end;

    FRight := TPadWidgetList.Create;
    for i := 0 to FQuestion.Right.Count-1 do
    begin
      Widget := FRight.AddSafely(TPadWidget.Create(nil));
      Widget.Model.Assign(FQuestion.Right[i]);
      Widget.Border := TRUE;
      Widget.ReadOnly := TRUE;
      Widget.Parent := FDragSpace;
      Widget.AddMouseListener(FDragSpace);
      Widget.Cursor := crSizeAll;
    end;

    FLeft := TPadWidgetList.Create;
    for i := 0 to FQuestion.CategoryCount-1 do
    begin
      Widget := FLeft.AddSafely(TPadWidget.Create(nil));
      Widget.Model.Assign(FQuestion.Categories[i].Title);
      Widget.ReadOnly := TRUE;
      Widget.Parent := FDragSpace;
      Widget.Border := TRUE;

      Container := TShape.Create(Self);
      Container.Parent := FDragSpace;
      Widget.Tag := PtrInt(Container);
    end;

    FDivider := TShape.Create(nil);
    FDivider.Parent := FDragSpace;
    FDivider.Width := DIVIDER_WIDTH;
    FDivider.Pen.Color := clGrayText;
    FDivider.AnchorParallel(akTop, 0, FDragSpace);
    FDivider.AnchorParallel(akBottom, 0, FDragSpace);

    FDragSpace.SetUp(Self);
  finally
    EnableAutoSizing;
  end;
end;

procedure TClassifyQuestionScreenFrame.GoReadOnly;
var
  w: TPadWidget;
begin
  FDragSpace.DraggingEnabled := FALSE;
  for w in FRight do
    w.Cursor := crDefault;
end;

function TClassifyQuestionScreenFrame.GetQuestion: TQuestion;
begin
  Result := FQuestion;
end;

procedure TClassifyQuestionScreenFrame.LayOut;
var
  Answer: TIntegerArray;
  ItemWidth, ContainerWidth, ItemHeight, i, n, y: Integer;
  Widget: TPadWidget;
  m: array of array of Integer;
  Container: TShape;
begin
  Answer := FQuestion.Response.GetAnswer;
  ItemWidth := Max((FDragSpace.ClientWidth - 2*CONTAINER_MARGIN
    - HSPACING - DIVIDER_WIDTH - HSPACING) div 2, 0);
  ContainerWidth := ItemWidth + 2*CONTAINER_MARGIN;
  FDivider.Left := ContainerWidth + HSPACING;

  ItemHeight := 0;
  for Widget in FRight do
  begin
    Widget.Width := ItemWidth;
    ItemHeight := Max(ItemHeight, GetPreferredControlSize(Widget).cy);
  end;

  SetLength(m, FLeft.Count);
  for i := 0 to FRight.Count-1 do
  begin
    n := Answer[i];
    if n <> -1 then
    begin
      SetLength(m[n], Length(m[n]) + 1);
      m[n, High(m[n])] := i;
    end;
  end;

  { Place category titles and containers. }
  y := 0;
  for i := 0 to FLeft.Count-1 do
  begin
    Widget := FLeft[i];
    Widget.Color := CONTAINER_COLOR;
    Widget.Top := y;
    Widget.Width := ContainerWidth;
    Widget.Height := GetPreferredControlSize(Widget).cy;
    Inc(y, Widget.Height - 1);

    Container := TShape(Widget.Tag);
    Container.Brush.Color := CONTAINER_COLOR;
    Container.Top := y;
    Container.Width := ContainerWidth;
    Container.Height := (Length(m[i]) + 1)*(ItemHeight + ITEM_VSPACING)
      - ITEM_VSPACING + 2*CONTAINER_MARGIN;
    Inc(y, Container.Height + CATEGORY_VSPACING);
  end;

  { Place items. }
  for i := 0 to FRight.Count-1 do
  begin
    Widget := FRight[i];
    Widget.Height := ItemHeight;
    if Answer[i] = -1 then { item is not in a container }
    begin
      Widget.Left := ContainerWidth + HSPACING + DIVIDER_WIDTH + HSPACING;
      Widget.Top := i*(ItemHeight + ITEM_VSPACING);
    end
    else
    begin
      n := FindArrayInteger(m[Answer[i]], i); { n = index of the item inside its container }
      Assert( n <> -1 );
      Container := TShape(FLeft[Answer[i]].Tag);
      Widget.Left := Container.Left + CONTAINER_MARGIN;
      Widget.Top := Container.Top + CONTAINER_MARGIN + n*(ItemHeight + ITEM_VSPACING);
    end;
  end;
end;

procedure TClassifyQuestionScreenFrame.NotifyBeginDrag;
begin
  FOldContainerIndex := -1;
end;

procedure TClassifyQuestionScreenFrame.NotifyDragging;
var
  ContainerIndex: Integer;
  OldCategory, NewCategory: TPadWidget;
begin
  ContainerIndex := GetContainerIndexUnderItem(FDragSpace.DragWidget);
  if ContainerIndex <> FOldContainerIndex then
  begin
    if FOldContainerIndex <> -1 then
    begin
      OldCategory := FLeft[FOldContainerIndex];
      OldCategory.Color := CONTAINER_COLOR;
      TShape(OldCategory.Tag).Brush.Color := CONTAINER_COLOR;
    end;
    FOldContainerIndex := ContainerIndex;
    if ContainerIndex <> -1 then
    begin
      NewCategory := FLeft[ContainerIndex];
      NewCategory.Color := HOT_TRACK_CONTAINER_COLOR;
      TShape(NewCategory.Tag).Brush.Color := HOT_TRACK_CONTAINER_COLOR;
    end;
  end;
end;

procedure TClassifyQuestionScreenFrame.NotifyEndDrag;
var
  ContainerIndex, ItemIndex: Integer;
  Answer: TIntegerArray;
begin
  ContainerIndex := GetContainerIndexUnderItem(FDragSpace.DragWidget);
  ItemIndex := FRight.IndexOf(FDragSpace.DragWidget);
  Answer := FQuestion.Response.GetAnswer;
  if Answer[ItemIndex] <> ContainerIndex then
  begin
    Answer[ItemIndex] := ContainerIndex;
    FQuestion.Response.SetAnswer(Answer);
  end;
end;

initialization

  QuestionScreenRegistry.Add(TClassifyQuestionScreenFrame, TClassifyQuestion);

end.

